home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #3 / Amiga Plus CD - 2002 - No. 03.iso / AmiSoft / Dev / E / Eviled.lha / gle.e < prev    next >
Encoding:
Text File  |  2003-02-02  |  13.4 KB  |  476 lines
  1. OPT MODULE
  2. OPT PREPROCESS
  3. OPT EXPORT
  4.  
  5.  
  6. CONST GLE_SPACEXY=-10, ->[spacex,spacey]
  7.       GLE_GADFLAGS=-20,  ->flags
  8.       GLE_UNITFACTORXY=-30, ->[hpix,vpix]
  9.       GLE_MUP=-40, -> steps in units
  10.       GLE_MDOWN=-50,  ->steps   -"-
  11.       GLE_MLEFT=-60,  ->steps   -""-
  12.       GLE_MRIGHT=-70, ->steps   -""-
  13.       GLE_ADDGAD=-90, -> id
  14.       GLE_SETGUISTARTXY=-110, ->[x,y]
  15.       GLE_PLACE=-130, ->[h,v]
  16.       GLE_PLACEXY=-140, ->[x,y]
  17.       GLE_MSX=-150, -> NIL
  18.       GLE_MSY=-160, -> NIL
  19.       GLE_GADTEXTATTR=-170, ->textattr
  20.       GLE_PLACING=-255,
  21.       GP_RIGHT=-260,
  22.       GP_UNDER=-270
  23.  
  24. -> EXPORT MACROs
  25. -> crappy son of a.. EC doesnt hadnle theese macros well..
  26. #define Gadget(kind,id,hsize,vsize,text,tags) gle.addGad(kind,id,hsize,vsize,text,tags)
  27. #define Button(id, width, text) gle.addGad( id, BUTTON_KIND, width, 1, text, NIL)
  28. #define SButton(id, text) gle.addGad( id, BUTTON_KIND, -1, 1, text, NIL)
  29. #define PlacingUnder gle.placing( GP_UNDER)
  30. #define PlacingRight gle.placing( GP_RIGHT)
  31. #define PlacingDiag  gle.placing( NIL)
  32. #define MoveU(steps) gle.mUp( steps)
  33. #define MoveD(steps) gle.mDown( steps)
  34. #define MoveL(steps) gle.mLeft( steps)
  35. #define MoveR(steps) gle.mRight( steps)
  36. #define MoveSX gle.mSX()
  37. #define MoveSY gle.mSY()
  38. #define OpenWin(tags) gle.openWin( tags)
  39. #define PlaceXY(x, y) gle.placeXY( x, y)
  40. #define Place(h, v) gle.place( h, v)
  41. #define GadFlags(flags) gle.gadFlags( flags)
  42. #define GadTextAttr(attr) gle.gadTextAttr( attr)
  43. #define SetGuiStartXY(x, y) gle.setGuiStartXY( x, y)
  44. #define UnitfactorXY(x, y) gle.unitfactorXY( x, y)
  45. #define SpaceXY(x, y) gle.spaceXY( x, y)
  46. #define Handler(proc, gadid) gle.eEventHandler( proc, gadid)
  47. #define HandleEvent(imsgcpy) gle.eHandleEvent( imsgcpy)
  48. #define SetGad(id,val) gle.setGad( id,val)
  49. #define GetGad(id) gle.setGad(id)
  50. #define GetWin gle.getWin()
  51.  
  52. ->990602 ; what did I do then ??
  53. -> 000512-13 ; wrote autodoc : self.library.doc
  54. -> moved opening of gadtools, utility into main()
  55. -> added closing of above libs in close()
  56. -> discovered there wasnt any closing of them before!!
  57. -> found a way to find out the windows titlebar height,
  58. -> BEFORE opening of the window! :) src/rkrm/gadtools/gadtoolsgadgets.e
  59. -> Gonna rename gle.SniffWin() to gle.SniffScreen()..
  60. -> NO, WAIT..hehe.. I can completely remove it instead :)
  61. -> putting the code to do it in gle.Init(); storing height in
  62. -> self.winbordheight. This means gle.FinWin() will dissapear
  63. -> too! Instead we add a Function -> gle.OpenWin() and for
  64. -> the sake of good looks, a CloseWin(). Adding self.window
  65. -> gle.Init() now sets unitfactirXY to a default, based on screenfont !
  66. -> works perfectly !! :)
  67. -> now adding possibility to make buttons auto-sized;
  68. -> pass -1 as width to gle.AddGad().
  69. -> also working on EXPORT MACROs in gle_tags.e
  70. -> removed closewin from functable; better to
  71. -> use gle.Quit() instead.
  72. ->000514
  73. -> added gle.GetWin()
  74. -> added gle.eHandleEvent(), GLe_eEventHandler()
  75. -> adding self.a4 : it crashed before because
  76. -> eventhandlers where called from library-environment!
  77. ->000529 : Adding AutoLen of gadgets based on the
  78. -> lenght of gadgettext. This is Ofcource just an addition,
  79. -> old style is left untouched! Just use -1 as widthvalue
  80. -> for the gadgets!
  81. -> 000603 : FIXED a bug that didnt update self.gui_maxx/y
  82. -> when moving around with the various move/place functions
  83. -> just addgad did it before.
  84.  
  85. -> 011024 : rewritten to class (again!) for YAEC !
  86.  
  87. -> 021108: ONCE AGAIN rewritten :) now compatible with EC.
  88.  
  89. MODULE 'intuition/screens', 'gadtools', 'libraries/gadtools','gadtools', 'libraries/gadtools',
  90.        'intuition/intuition', 'utility', 'utility/tagitem',
  91.        'graphics/text', 'graphics/rastport'
  92.  
  93. OBJECT gle ->buildgadgetlist - data
  94.    PRIVATE
  95.    glist:PTR TO gadget      -> hämta med gle.getGlist(gle)
  96.    gpa:PTR TO LONG     ->adress till array av gadpekare.
  97.    gadptr:PTR TO gadget
  98.    newgad:newgadget
  99.    ->-------------
  100.    unitfactorx:INT  ->sizefactor  h-unitsize
  101.    unitfactory:INT ->sizefactor  v-unitsize
  102.    gui_startx:INT  -> övre vänstra hörent
  103.    gui_starty:INT  -> att sätta första gaden.
  104.    gui_maxx:INT       -> nedre högra hörnet
  105.    gui_maxy:INT       -> på hela GUI:et.
  106.    cp_x:INT        -> nedre högra hörnet på senaste
  107.    cp_y:INT        -> gaden. eller om den sätts till
  108.                    -> nåt annat av gle_PlacePix() eller
  109.                    ->tableft/tabup! bla..
  110.  
  111.    spacex:CHAR     -> mellanrum mellan gadgets vertikalt
  112.    spacey:CHAR     ->         (i pixels)       horisontellt
  113.    ->gadkind:LONG ->the usual..
  114.    gadtags:LONG
  115.    gadplacing:INT ->GP_RIGHT, GP_UNDER
  116.    winbordheight:CHAR -> 000513
  117.    window:PTR TO window -> 000513
  118.    screen -> 000513
  119.    ppa:PTR TO LONG
  120. ENDOBJECT
  121.  
  122.  
  123. EXPORT CONST GLE_ERR_VISUAL = "visu",
  124.       GLE_ERR_CONTEXT = "ctxt",
  125.       GLE_ERR_WIN = "gwin"
  126.  
  127. PROC gle(screen:PTR TO screen, gpa=NIL, ppa=NIL) OF gle
  128.    DEF glist=NIL
  129.    self.newgad.visualinfo:=GetVisualInfoA(screen,[NIL])
  130.    IF self.newgad.visualinfo=NIL THEN Raise(GLE_ERR_VISUAL)
  131.    self.gadptr:=CreateContext({glist})
  132.    IF self.gadptr=NIL THEN Raise(GLE_ERR_CONTEXT)
  133.    self.glist:=glist
  134.    self.gpa:=gpa
  135.    self.winbordheight := screen.wbortop+screen.font.ysize+1 -> 000513
  136.    self.setGuiStartXY(6, 3 + self.winbordheight) -> 000513
  137.    self.mSX()
  138.    self.mSY()
  139.    ->self.unitfactorXY(screen.rastport.txwidth, screen.rastport.txheight+6)
  140.    self.unitfactorXY(pixPerChar(screen), 2 + self.winbordheight) -> 000513
  141.    self.screen := screen -> 000513
  142.    self.ppa := ppa
  143. ENDPROC
  144.  
  145.  
  146. PROC end() OF gle
  147.    IF self.window THEN CloseWindow(self.window)
  148.    IF self.newgad.visualinfo THEN FreeVisualInfo(self.newgad.visualinfo)
  149.    IF self.glist THEN FreeGadgets(self.glist)
  150. ENDPROC
  151.  
  152. PROC spaceXY(xspace, yspace) OF gle
  153.    self.spacex:=xspace
  154.    self.spacey:=yspace
  155. ENDPROC xspace, yspace
  156.  
  157. PROC unitfactorXY(xval, yval) OF gle
  158.    self.unitfactorx:=xval
  159.    self.unitfactory:=yval
  160. ENDPROC xval, yval
  161.  
  162. PROC mSX() OF gle
  163.    self.cp_x:=self.gui_startx
  164. ENDPROC self.cp_x
  165.  
  166. PROC mSY() OF gle
  167.    self.cp_y:=self.gui_starty
  168. ENDPROC self.cp_y
  169.  
  170. PROC mDown(units) OF gle
  171.    self.cp_y:=(self.cp_y)+(units*self.unitfactory)+(units*self.spacey)
  172.    self.computeMaxCoords()
  173. ENDPROC self.cp_y
  174.  
  175. PROC mRight(units) OF gle
  176.    self.cp_x:=(self.cp_x)+(units*self.unitfactorx)+(units*self.spacex)
  177.    self.computeMaxCoords()
  178. ENDPROC self.cp_x
  179.  
  180. PROC mUp(units) OF gle
  181.    self.cp_y:=(self.cp_y)-(units*self.unitfactory)-(units*self.spacey)
  182. ENDPROC self.cp_y
  183.  
  184. PROC mLeft(units) OF gle
  185.    self.cp_x:=(self.cp_x)-(units*self.unitfactorx)-(units*self.spacex)
  186. ENDPROC self.cp_x
  187.  
  188.  
  189. PROC setGuiStartXY(x, y) OF gle
  190.    self.gui_startx:=x
  191.    self.gui_starty:=y
  192.    self.computeMaxCoords()
  193. ENDPROC x, y
  194.  
  195. PROC addGad(kind, id, hsize, vsize, text=NIL, tags=NIL) OF gle
  196.    IF hsize = -1 THEN hsize := StrLen(text)
  197.    self.newgad.gadgetid:=id
  198.    self.newgad.width:=(hsize*self.unitfactorx)+((hsize-1)*self.spacex)
  199.    self.newgad.height:=(vsize*self.unitfactory)+((vsize-1)*self.spacey)
  200.    self.newgad.leftedge:=self.cp_x
  201.    self.newgad.topedge:=self.cp_y
  202.    self.newgad.gadgettext:=text
  203.    self.newgad.userdata:=kind ->990526,000514
  204.    self.gadptr:=CreateGadgetA(kind, self.gadptr,
  205.                              self.newgad,tags)
  206.    self.cp_x:=(self.cp_x)+(self.newgad.width)+self.spacex
  207.    self.cp_y:=(self.cp_y)+(self.newgad.height)+self.spacey
  208.    self.computeMaxCoords()
  209.    IF self.gpa<>NIL THEN self.gpa[id]:=self.gadptr
  210.    IF (self.gadplacing = GP_RIGHT) THEN self.mUp(vsize)
  211.    IF (self.gadplacing = GP_UNDER) THEN self.mLeft(hsize)
  212. ENDPROC self.gadptr
  213.  
  214. /* internal */
  215. PROC computeMaxCoords() OF gle
  216.    self.gui_maxx:=Max(self.cp_x, self.gui_maxx)
  217.    self.gui_maxy:=Max(self.cp_y, self.gui_maxy)
  218. ENDPROC
  219.  
  220. PROC getCpX() OF gle IS self.cp_x
  221.  
  222. PROC getCpY() OF gle IS self.cp_y
  223.  
  224. PROC getMaxX() OF gle IS self.gui_maxx
  225.  
  226. PROC getMaxY() OF gle IS self.gui_maxy
  227.  
  228. PROC gadTextAttr(textattr) OF gle
  229.    self.newgad.textattr:=textattr
  230. ENDPROC
  231.  
  232. PROC getGList() OF gle IS self.glist
  233.  
  234. ->added 990523-----------------------
  235.  
  236. PROC gadFlags(flags) OF gle
  237.    self.newgad.flags:=flags
  238. ENDPROC
  239.  
  240. EXPORT PROC pixPerChar(screen:PTR TO screen) 
  241.    DEF testtext, pixperchar
  242.    testtext:='abcdefghijklmnopqrstuvwxyzåäö' +
  243.              'ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖ' +
  244.              '123456789'
  245.    pixperchar:=TextLength(screen.rastport,testtext,67)
  246.    pixperchar:=pixperchar/60
  247. ENDPROC pixperchar
  248.  
  249. EXPORT PROC copyIMessage(msg:PTR TO intuimessage, imsgcpy:PTR TO intuimessage) 
  250.    imsgcpy.code:=msg.code
  251.    imsgcpy.qualifier:=msg.qualifier
  252.    imsgcpy.iaddress:=msg.iaddress
  253.    imsgcpy.class:=msg.class
  254.    imsgcpy.mousex:=msg.mousex
  255.    imsgcpy.mousey:=msg.mousey
  256. ENDPROC imsgcpy
  257.  
  258.  
  259.  
  260. PROC place(xunit, yunit) OF gle
  261.    self.mSX()
  262.    self.mSY()
  263.    self.mRight(xunit)
  264.    self.mDown(yunit)
  265. ENDPROC
  266.  
  267. /* These two has nothing to do with gad creation.. */
  268. /* just nice to have when ya wanna get/set gadgets later.. */
  269. PROC setGad(gadid, attr) OF gle
  270.    DEF kind, tag, gad:PTR TO gadget
  271.    gad := self.gpa[gadid]
  272.    kind:=gad.userdata
  273.    SELECT kind
  274.    CASE CHECKBOX_KIND
  275.       tag:=GTCB_CHECKED
  276.    CASE CYCLE_KIND
  277.       tag:=GTCY_ACTIVE
  278.    CASE INTEGER_KIND
  279.       tag:=GTIN_NUMBER
  280.    CASE LISTVIEW_KIND
  281.       tag:=GTLV_SELECTED
  282.    CASE MX_KIND
  283.       tag:=GTMX_ACTIVE
  284.    CASE NUMBER_KIND
  285.       tag:=GTNM_NUMBER
  286.    CASE PALETTE_KIND
  287.       tag:=GTPA_COLOR
  288.    CASE SCROLLER_KIND
  289.       tag:=GTSC_VISIBLE
  290.    CASE SLIDER_KIND
  291.       tag:=GTSL_LEVEL
  292.    CASE STRING_KIND
  293.       tag:=GTST_STRING
  294.    CASE TEXT_KIND
  295.       tag:=GTTX_TEXT
  296.    DEFAULT
  297.       RETURN NIL
  298.    ENDSELECT
  299.    Gt_SetGadgetAttrsA(gad, self.window, NIL, [tag, attr, NIL])
  300. ENDPROC attr
  301.  
  302. PROC getGad(gadid) OF gle
  303.    DEF kind, attr, tag, gad:PTR TO gadget
  304.    gad := self.gpa[gadid]
  305.    kind:=gad.userdata
  306.    SELECT kind
  307.    CASE CHECKBOX_KIND
  308.       tag:=GTCB_CHECKED
  309.    CASE CYCLE_KIND
  310.       tag:=GTCY_ACTIVE
  311.    CASE INTEGER_KIND
  312.       tag:=GTIN_NUMBER
  313.    CASE LISTVIEW_KIND
  314.       tag:=GTLV_SELECTED
  315.    CASE MX_KIND
  316.       tag:=GTMX_ACTIVE
  317.    CASE NUMBER_KIND
  318.       tag:=GTNM_NUMBER
  319.    CASE PALETTE_KIND
  320.       tag:=GTPA_COLOR
  321.    CASE SCROLLER_KIND
  322.       tag:=GTSC_VISIBLE
  323.    CASE SLIDER_KIND
  324.       tag:=GTSL_LEVEL
  325.    CASE STRING_KIND
  326.       tag:=GTST_STRING
  327.    CASE TEXT_KIND
  328.       tag:=GTTX_TEXT
  329.    DEFAULT
  330.       RETURN NIL
  331.    ENDSELECT
  332.    Gt_GetGadgetAttrsA(gad, self.window, NIL, [tag, {attr}, NIL])
  333. ENDPROC attr
  334.  
  335.  
  336.  
  337. PROC placeXY(x, y) OF gle
  338.    self.cp_x:=(self.gui_startx) + x
  339.    self.cp_y:=(self.gui_starty) + y
  340.    self.computeMaxCoords()
  341. ENDPROC x,y
  342.  
  343.  
  344. /* the biggie... */
  345.  
  346. PROC buildA(tags) OF gle
  347.    DEF tag:PTR TO tagitem, ti_tag, lptr:PTR TO LONG, ti_data
  348.    WHILE (tag:=NextTagItem({tags}) )
  349.       ti_tag:=tag.tag
  350.       ti_data:=tag.data
  351.       lptr := ti_data
  352.       SELECT ti_tag
  353.       CASE GLE_SPACEXY
  354.          self.spaceXY(lptr[0], lptr[1])
  355.       CASE GLE_GADFLAGS
  356.          self.gadFlags(ti_data)
  357.       CASE GLE_UNITFACTORXY
  358.          self.unitfactorXY(lptr[0], lptr[1])
  359.       CASE GLE_MUP
  360.          self.mUp(ti_data)
  361.       CASE GLE_MDOWN
  362.          self.mDown(ti_data)
  363.       CASE GLE_MLEFT
  364.          self.mLeft(ti_data)
  365.       CASE GLE_MRIGHT
  366.          self.mRight(ti_data)
  367.       CASE GLE_ADDGAD
  368.          self.addGad(lptr[0], lptr[1], lptr[2],
  369.                          lptr[3], lptr[4], lptr[5])
  370.       CASE GLE_SETGUISTARTXY
  371.          self.setGuiStartXY(lptr[0], lptr[1])
  372.       CASE GLE_PLACE
  373.          self.place(lptr[0], lptr[1])
  374.       CASE GLE_PLACEXY
  375.          self.placeXY(lptr[0], lptr[1])
  376.       CASE GLE_MSX
  377.          self.mSX()
  378.       CASE GLE_MSY
  379.          self.mSY()
  380.       CASE GLE_GADTEXTATTR
  381.          self.gadTextAttr(ti_data)
  382.       CASE GLE_PLACING
  383.          self.placing(ti_data)
  384.       ENDSELECT
  385.    ENDWHILE
  386. ENDPROC
  387.  
  388. PROC placing(placing) OF gle
  389.    self.gadplacing:=placing
  390. ENDPROC
  391.  
  392.  
  393. EXPORT PROC findGad(first:PTR TO gadget, id)
  394.    WHILE first <> NIL
  395.       IF first.gadgetid = id THEN RETURN first
  396.       first := first.nextgadget
  397.    ENDWHILE
  398. ENDPROC NIL
  399.  
  400. -> 000513
  401.  
  402. PROC openWin(tags) OF gle
  403.    self.window := OpenWindowTagList(NIL,
  404.                      [WA_GADGETS,   self.glist,
  405.                       WA_INNERWIDTH,  (self.gui_maxx) - 2,
  406.                       WA_INNERHEIGHT, (self.gui_maxy) - self.winbordheight + 1,
  407.                       ->WA_SIZEGADGET, FALSE,
  408.                       WA_PUBSCREEN, self.screen,
  409.                       TAG_MORE, tags,
  410.                       NIL])
  411.    IF self.window = NIL THEN Raise(GLE_ERR_WIN)
  412. ENDPROC self.window
  413.  
  414. PROC getWin() OF gle IS self.window
  415.  
  416.  
  417. -> 000514 : handles gad-evnets. E-ONLY!
  418. PROC handleEvent(imsgcpy:PTR TO intuimessage) OF gle
  419.    DEF gad:PTR TO gadget, proc, gadval
  420.    IF (gad := imsgcpy.iaddress) = NIL THEN RETURN
  421.    IF (proc := self.ppa[gad.gadgetid]) = NIL THEN RETURN
  422.    gadval := self.getGad(gad.gadgetid)
  423. ENDPROC proc(self, gad, gadval)
  424.  
  425. PROC eventHandler(proc, gadid) OF gle
  426.    IF self.ppa THEN self.ppa[gadid] := proc -> add handler
  427. ENDPROC
  428.  
  429. ->PROC getGadPtr(gid) OF gle IS self.gpa[gid]
  430.  
  431. /* Swedish Doc...
  432.  
  433. ->initiering ..gpa=gadptrarray som e allokerad, kan vara NIL.
  434. gle:=gle_init(screen, gpa)
  435.  
  436. ->fria resurser (antagligen vid programslut)
  437. gle_quit(gle)
  438.  
  439. ->sätt mellanrum mellan gadgets
  440. xspace, yspace:=gle_setspace( xspace, yspace)
  441.  
  442. ->sätt 'teckenstorlek'
  443. wf, hf:=gle_setgadsizefactor( wf, hf)
  444.  
  445. ->förflytta 'markören'
  446. cpx:=gle_mleft(gle ,wval)
  447. cpx:=gle_mright( wval)
  448. cpy:=gle_mdown( hval)
  449. cpy:=gle_mup( hval)
  450. sx:=gle_msx(gle)
  451. sy:=gle_msy(gle)
  452.  
  453. ->x och y för gle_msx/y
  454. gle_setstartxy( x, y)
  455.  
  456. ->addera en gad till gadlisten
  457. gad:=gle_addgad( kind, id, wval, hval, gadtxt, flags, tags)
  458.  
  459. ->sätt fonten till nåt annat än standard.
  460. gle_settextattr( textattr)
  461.  
  462. ->hämta hittils största x och y värde för markören.
  463. x:=gle_getmaxx(gle)
  464. y:=gle_getmaxy(gle)
  465.  
  466. ->hämta gadlisten (antagligen till fönsteröppningen)
  467. gadlist:=gle_getglist(gle)
  468.  
  469. ->hämta nuvarande markörs xy-position
  470. x:=gle_getcpx(gle)
  471. y:=gle_getcpy(gle)
  472.  
  473.  
  474. */
  475.  
  476.